home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
win
/
pasock10.zip
/
FINGER.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-11-16
|
7KB
|
248 lines
{
Public Domain - Please leave this notice intact.
Mike Caughran Cedar Island Software OCT 1994
All the usual disclaimers apply.
Implement a finger client using Borland Pascal 7
71034.2371@compuserve.com
907-789-9030 voice
907-789-1694 bbs
}
{
Finger is one of the easiest clients to implement.
WinCRT is used also for clarity. (Eschew Obfuscation.)
Finger usually resides on socket 79.
}
program finger;
uses winsock, strings, wincrt, winprocs, wintypes;
var
myVerReqd : word;
myWSAData : WSADATA;
s : String[255];
i : integer;
CharArray: array[0..255] of char;
HostNameArray: array[0..255] of char;
FingerSocket : tSOCKET;
err : integer;
FingerPort : word;
Remote_Addr: sockaddr_in;
Remote_Host: Phostent;
procedure CleanUp; Forward;
{----------------------------------------}
{ -- Start of code to SubClass WinCRT -- }
{----------------------------------------}
var
OldWndProc : TFarProc;
const
hCRTWnd : HWND = 0;
cm_Exit = 100;
cm_About = 101;
function WindowProc(Window:HWnd; Message,wParam:Word; lParam:LongInt) : LongInt; export;
begin
case Message of
wm_Char : begin
if wParam=vk_Escape then begin
CleanUp;
DoneWinCRT;
end;
end;
wm_Command : begin
case WParam of
cm_About: MessageBox(Window,
'Finger Client'#13'Public Domain 1994 by'#13'Mike Caughran'#13'Cedar Island Software',
'Pascal Finger Client',mb_IconExclamation);
cm_Exit: begin
CleanUp;
DoneWinCrt;
end;
end;
end;
end;
WindowProc := CallWindowProc(OldWndProc, Window, Message, wParam, lParam);
end;
procedure MakeMenu;
var
Menu : HMenu;
FileMenu : HMenu;
begin
Menu := CreateMenu;
FileMenu := CreateMenu;
AppendMenu(Menu, mf_PopUp or mf_Enabled, FileMenu, 'File');
AppendMenu(FileMenu, mf_Enabled, cm_Exit, 'Exit');
AppendMenu(Menu, mf_Enabled, cm_About, 'About');
SetMenu(hCRTWnd,Menu);
end;
procedure myInitWinCRT;
var
hInstance : THandle;
WindowClass : TWndClass;
begin
GetClassInfo(hInstance, 'TPWinCrt' ,WindowClass);
UnregisterClass('TPWinCRT', hInstance);
WindowClass.hIcon := LoadIcon(0, idi_Exclamation);
WindowClass.hCursor := LoadCursor(0, idc_Arrow);
OldWndProc := tFarProc(WindowClass.lpfnWndProc);
WindowClass.lpfnWndProc := @WindowProc;
RegisterClass(WindowClass);
InactiveTitle := '%s';
StrCopy(WindowTitle,'Pascal Finger Client V1.0');
InitWinCrt;
hCRTWnd := GetActiveWindow;
MakeMenu;
end;
{--------------------------------------}
{ -- End of code to SubClass WinCRT -- }
{--------------------------------------}
{$I ERROR.INC}
procedure StartUp;
begin
myVerReqd:=$0101;
Writeln('Winsock version required : ',hibyte(myVerReqd),'.',lobyte(myVerReqd));
if WSAStartup(myVerReqd,@myWSAData) <>0 then Abort('WSAStartup');
end;
procedure ShowWinSockInfo;
begin
Write('Winsock Version found: ');
Writeln(lobyte(myWSAData.wVersion),'.',lobyte(myWSAData.wHighVersion));
S := StrPas(myWSAData.szDescription);
Writeln('Description=',S);
S := StrPas(myWSAData.szSystemStatus);
Writeln('SystemStatus=',S);
Writeln('MaxSockets=',word(myWSAData.iMaxSockets));
Writeln('MaxUdpDg=',word(myWSAData.iMaxUdpDg));
Write('VendorInfo= ');
if myWSAData.lpVendorInfo <> NIL then begin
writeln(myWSAData.lpVendorInfo);
end else writeln('NULL');
Write('Local Hostname=');
if (gethostname(@CharArray,255) <> 0) then Error('GetHostName')
else writeln(CharArray);
end;
procedure PromptForHostname;
var
aString : String;
begin
writeln;
write('Remote Hostname : ');
readln(aString);
strPcopy(HostNameArray, aString);
Remote_Host :=gethostbyname(HostNameArray);
if Remote_Host = Nil then begin
Writeln; Writeln('Can''t find host.'); Writeln;
Abort('GetHostByName');
end
else begin
Remote_Host^.h_addr := Remote_Host^.h_addr_list^; {h_addr := h_addr_list[0]}
{
Writeln(byte(Remote_Host^.h_addr[0]),'.',
byte(Remote_Host^.h_addr[1]),'.',
byte(Remote_Host^.h_addr[2]),'.',
byte(Remote_Host^.h_addr[3]));
}
end;
end;
procedure FindFingerService;
var
pSE : pServEnt;
begin
FingerPort := 0;
pSE := getservbyname('finger','tcp');
if pSE = nil then begin
Error('GetServByName'); Writeln;
Writeln('Finger is usually on port 79. Check Services table.');
end
else begin
FingerPort := htons(pSE^.s_port);
Writeln('Using finger service on port ',FingerPort);
end;
end;
procedure CreateSocket;
begin
FingerSocket:=socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
If FingerSocket = INVALID_SOCKET then Abort('Can''t CreateSocket')
else
Writeln('Socket descriptor allocated : ',ord(FingerSocket));
end;
procedure ConnectToPort;
begin
Remote_addr.sin_family := PF_INET;
Remote_addr.sin_port := htons(FingerPort);
Remote_addr.sin_addr.S_un_b.s_b1:=Remote_Host^.h_addr[0];
Remote_addr.sin_addr.S_un_b.s_b2:=Remote_Host^.h_addr[1];
Remote_addr.sin_addr.S_un_b.s_b3:=Remote_Host^.h_addr[2];
Remote_addr.sin_addr.S_un_b.s_b4:=Remote_Host^.h_addr[3];
writeln('Connecting to ',inet_ntoa(Remote_Addr.sin_addr));
if connect(FingerSocket, sockaddr(Remote_Addr), SizeOf(Remote_Addr)) <> 0 then
begin
CloseSocket(FingerSocket);
Abort('Connect');
end;
end;
procedure SendTxt(ABuff : PChar);
begin
if send(FingerSocket, ABuff, StrLen(ABuff), 0) < StrLen(ABuff) then
Error('Send');
end;
function RecvTxt(ABuff : PChar) : boolean;
var
rc,i : integer;
begin
RecvTxt := True;
rc := recv(FingerSocket, ABuff, 1024, 0);
if rc = SOCKET_ERROR then begin
RecvTxt := False;
Error('Recv');
end
else if rc = 0 then begin
ABuff := '';
RecvTxt := False;
end;
end;
procedure CleanUp;
begin
if WSACleanup <> 0 then Error('WSACleanup');
end;
var
Buff : array [0..1024] of char;
procedure DoFinger;
begin
StartUp;
ShowWinsockInfo;
PromptForHostname;
FindFingerService;
CreateSocket;
ConnectToPort;
writeln;
SendTxt('Hello from finger world'#13#10);
while RecvTxt(@Buff) do write(Buff);
CleanUp;
end;
begin
MyInitWinCRT;
DoFinger;
end.